home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_gnu / adainc / a-strsea.adb < prev    next >
Text File  |  1996-01-30  |  10KB  |  364 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --                   A D A . S T R I N G S . S E A R C H                    --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.13 $                              --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- The GNAT library is free software; you can redistribute it and/or modify --
  14. -- it under terms of the GNU Library General Public License as published by --
  15. -- the Free Software  Foundation; either version 2, or (at your option) any --
  16. -- later version.  The GNAT library is distributed in the hope that it will --
  17. -- be useful, but WITHOUT ANY WARRANTY;  without even  the implied warranty --
  18. -- of MERCHANTABILITY  or  FITNESS FOR  A PARTICULAR PURPOSE.  See the  GNU --
  19. -- Library  General  Public  License for  more  details.  You  should  have --
  20. -- received  a copy of the GNU  Library  General Public License  along with --
  21. -- the GNAT library;  see the file  COPYING.LIB.  If not, write to the Free --
  22. -- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.        --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. --  Note: This code is derived from the ADAR.CSH public domain Ada 83
  27. --  versions of the Appendix C string handling packages (code extracted
  28. --  from Ada.Strings.Fixed). A significant change is that we optimize the
  29. --  case of identity mappings for Count and Index, and also Index_Non_Blank
  30. --  is specialized (rather than using the general Index routine).
  31.  
  32.  
  33. with Ada.Strings.Maps; use Ada.Strings.Maps;
  34.  
  35. package body Ada.Strings.Search is
  36.  
  37.    -----------------------
  38.    -- Local Subprograms --
  39.    -----------------------
  40.  
  41.    function Belongs
  42.      (Element : Character;
  43.       Set     : Maps.Character_Set;
  44.       Test    : Membership)
  45.       return    Boolean;
  46.    pragma Inline (Belongs);
  47.    --  Determines if the given element is in (Test = Inside) or not in
  48.    --  (Test = Outside) the given character set.
  49.  
  50.    -------------
  51.    -- Belongs --
  52.    -------------
  53.  
  54.    function Belongs
  55.      (Element : Character;
  56.       Set     : Maps.Character_Set;
  57.       Test    : Membership)
  58.       return    Boolean
  59.    is
  60.    begin
  61.       if Test = Inside then
  62.          return Is_In (Element, Set);
  63.       else
  64.          return not Is_In (Element, Set);
  65.       end if;
  66.    end Belongs;
  67.  
  68.    -----------
  69.    -- Count --
  70.    -----------
  71.  
  72.    function Count
  73.      (Source   : in String;
  74.       Pattern  : in String;
  75.       Mapping  : in Maps.Character_Mapping := Maps.Identity)
  76.       return     Natural
  77.    is
  78.       N : Natural;
  79.       J : Natural;
  80.  
  81.       Mapped_Source : String (Source'Range);
  82.  
  83.    begin
  84.       for J in Source'Range loop
  85.          Mapped_Source (J) := Value (Mapping, Source (J));
  86.       end loop;
  87.  
  88.       if Pattern = "" then
  89.          raise Pattern_Error;
  90.       end if;
  91.  
  92.       N := 0;
  93.       J := Source'First;
  94.  
  95.       while J <= Source'Last - (Pattern'Length - 1) loop
  96.          if Mapped_Source (J .. J + (Pattern'Length - 1)) = Pattern then
  97.             N := N + 1;
  98.             J := J + Pattern'Length;
  99.          else
  100.             J := J + 1;
  101.          end if;
  102.       end loop;
  103.  
  104.       return N;
  105.    end Count;
  106.  
  107.    function Count
  108.      (Source   : in String;
  109.       Pattern  : in String;
  110.       Mapping  : in Maps.Character_Mapping_Function)
  111.       return     Natural
  112.    is
  113.       Mapped_Source : String (Source'Range);
  114.       N             : Natural;
  115.       J             : Natural;
  116.  
  117.    begin
  118.       if Pattern = "" then
  119.          raise Pattern_Error;
  120.       end if;
  121.  
  122.       for J in Source'Range loop
  123.          Mapped_Source (J) := Mapping.all (Source (J));
  124.       end loop;
  125.  
  126.       N := 0;
  127.       J := Source'First;
  128.  
  129.       while J <= Source'Last - (Pattern'Length - 1) loop
  130.          if Mapped_Source (J .. J + (Pattern'Length - 1)) = Pattern then
  131.             N := N + 1;
  132.             J := J + Pattern'Length;
  133.          else
  134.             J := J + 1;
  135.          end if;
  136.       end loop;
  137.  
  138.       return N;
  139.    end Count;
  140.  
  141.    function Count
  142.      (Source : in String;
  143.       Set    : in Maps.Character_Set)
  144.       return   Natural
  145.    is
  146.       N : Natural := 0;
  147.  
  148.    begin
  149.       for J in Source'Range loop
  150.          if Is_In (Source (J), Set) then
  151.             N := N + 1;
  152.          end if;
  153.       end loop;
  154.  
  155.       return N;
  156.    end Count;
  157.  
  158.    ----------------
  159.    -- Find_Token --
  160.    ----------------
  161.  
  162.    procedure Find_Token
  163.      (Source : in String;
  164.       Set    : in Maps.Character_Set;
  165.       Test   : in Membership;
  166.       First  : out Positive;
  167.       Last   : out Natural)
  168.    is
  169.    begin
  170.       for J in Source'Range loop
  171.          if Belongs (Source (J), Set, Test) then
  172.             First := J;
  173.  
  174.             for K in J + 1 .. Source'Last loop
  175.                if not Belongs (Source (K), Set, Test) then
  176.                   Last := K - 1;
  177.                   return;
  178.                end if;
  179.             end loop;
  180.  
  181.             --  Here if J indexes 1st char of token, and all chars
  182.             --  after J are in the token
  183.  
  184.             Last := Source'Last;
  185.             return;
  186.          end if;
  187.       end loop;
  188.  
  189.       --  Here if no token found
  190.  
  191.       First := Source'First;
  192.       Last  := 0;
  193.    end Find_Token;
  194.  
  195.    -----------
  196.    -- Index --
  197.    -----------
  198.  
  199.    function Index
  200.      (Source   : in String;
  201.       Pattern  : in String;
  202.       Going    : in Direction := Forward;
  203.       Mapping  : in Maps.Character_Mapping := Maps.Identity)
  204.       return     Natural
  205.    is
  206.       Cur_Index     : Natural;
  207.       Mapped_Source : String (Source'Range);
  208.  
  209.  
  210.    begin
  211.       if Pattern = "" then
  212.          raise Pattern_Error;
  213.       end if;
  214.  
  215.       for J in Source'Range loop
  216.          Mapped_Source (J) := Value (Mapping, Source (J));
  217.       end loop;
  218.  
  219.       --  Forwards case
  220.  
  221.       if Going = Forward then
  222.          for J in 1 .. Source'Length - Pattern'Length + 1 loop
  223.             Cur_Index := Source'First + J - 1;
  224.  
  225.             if Pattern = Mapped_Source
  226.                            (Cur_Index .. Cur_Index + Pattern'Length - 1)
  227.             then
  228.                return Cur_Index;
  229.             end if;
  230.          end loop;
  231.  
  232.       --  Backwards case
  233.  
  234.       else
  235.          for J in reverse 1 .. Source'Length - Pattern'Length + 1 loop
  236.             Cur_Index := Source'First + J - 1;
  237.  
  238.             if Pattern = Mapped_Source
  239.                            (Cur_Index .. Cur_Index + Pattern'Length - 1)
  240.             then
  241.                return Cur_Index;
  242.             end if;
  243.          end loop;
  244.       end if;
  245.  
  246.       --  Fall through if no match found. Note that the loops are skipped
  247.       --  completely in the case of the pattern being longer than the source.
  248.  
  249.       return 0;
  250.    end Index;
  251.  
  252.    function Index (Source   : in String;
  253.                    Pattern  : in String;
  254.                    Going    : in Direction := Forward;
  255.                    Mapping  : in Maps.Character_Mapping_Function)
  256.       return Natural
  257.    is
  258.       Mapped_Source : String (Source'Range);
  259.       Cur_Index     : Natural;
  260.  
  261.    begin
  262.       if Pattern = "" then
  263.          raise Pattern_Error;
  264.       end if;
  265.  
  266.       for J in Source'Range loop
  267.          Mapped_Source (J) := Mapping.all (Source (J));
  268.       end loop;
  269.  
  270.       --  Forwards case
  271.  
  272.       if Going = Forward then
  273.          for J in 1 .. Source'Length - Pattern'Length + 1 loop
  274.             Cur_Index := Source'First + J - 1;
  275.  
  276.             if Pattern = Mapped_Source
  277.                            (Cur_Index .. Cur_Index + Pattern'Length - 1)
  278.             then
  279.                return Cur_Index;
  280.             end if;
  281.          end loop;
  282.  
  283.       --  Backwards case
  284.  
  285.       else
  286.          for J in reverse 1 .. Source'Length - Pattern'Length + 1 loop
  287.             Cur_Index := Source'First + J - 1;
  288.  
  289.             if Pattern = Mapped_Source
  290.                            (Cur_Index .. Cur_Index + Pattern'Length - 1)
  291.             then
  292.                return Cur_Index;
  293.             end if;
  294.          end loop;
  295.       end if;
  296.  
  297.       return 0;
  298.    end Index;
  299.  
  300.    function Index
  301.      (Source : in String;
  302.       Set    : in Maps.Character_Set;
  303.       Test   : in Membership := Inside;
  304.       Going  : in Direction  := Forward)
  305.       return   Natural
  306.    is
  307.    begin
  308.       --  Forwards case
  309.  
  310.       if Going = Forward then
  311.          for J in Source'Range loop
  312.             if Belongs (Source (J), Set, Test) then
  313.                return J;
  314.             end if;
  315.          end loop;
  316.  
  317.       --  Backwards case
  318.  
  319.       else
  320.          for J in reverse Source'Range loop
  321.             if Belongs (Source (J), Set, Test) then
  322.                return J;
  323.             end if;
  324.          end loop;
  325.       end if;
  326.  
  327.       --  Fall through if no match
  328.  
  329.       return 0;
  330.    end Index;
  331.  
  332.    ---------------------
  333.    -- Index_Non_Blank --
  334.    ---------------------
  335.  
  336.    function Index_Non_Blank
  337.      (Source : in String;
  338.       Going  : in Direction := Forward)
  339.       return   Natural
  340.    is
  341.    begin
  342.       if Going = Forward then
  343.          for J in Source'Range loop
  344.             if Source (J) /= ' ' then
  345.                return J;
  346.             end if;
  347.          end loop;
  348.  
  349.       else -- Going = Backward
  350.          for J in reverse Source'Range loop
  351.             if Source (J) /= ' ' then
  352.                return J;
  353.             end if;
  354.          end loop;
  355.       end if;
  356.  
  357.       --  Fall through if no match
  358.  
  359.       return 0;
  360.  
  361.    end Index_Non_Blank;
  362.  
  363. end Ada.Strings.Search;
  364.